Osetreni DragDrop na formu

Otázka od: Ing. Igor Kapoun

25. 6. 2004 12:49

Potreboval bych osetrit udalost pretazeni ikony souboru napr. z pruzkumnika
nebo z WinCommanderu na formular me aplikace (ekvivalent pretazeni ikony
souboru za ucelem kopirovani nebo presunu souboru mezi dvema okny).
Potrebuji zjistit nazev souboru a cestu. Pomuze mi nekdo? Dekuji.
Igor

Odpovedá: Ing. Pavel Spisar

25. 6. 2004 13:27

podivej se po komponente FileDrop od Thomas Werner,
pripadne napis mimo konferenci (funguje v D3)
Ing. Igor Kapoun wrote:
> Potreboval bych osetrit udalost pretazeni ikony souboru napr. z
> pruzkumnika nebo z WinCommanderu na formular me aplikace (ekvivalent
> pretazeni ikony souboru za ucelem kopirovani nebo presunu souboru
> mezi dvema okny). Potrebuji zjistit nazev souboru a cestu. Pomuze mi
> nekdo? Dekuji.
> Igor

Odpovedá: Ondrej Kelle

25. 6. 2004 13:32

> Potreboval bych osetrit udalost pretazeni ikony souboru napr.
> z pruzkumnika nebo z WinCommanderu na formular me aplikace
> (ekvivalent pretazeni ikony souboru za ucelem kopirovani
> nebo presunu souboru mezi dvema okny).
> Potrebuji zjistit nazev souboru a cestu. Pomuze mi nekdo? Dekuji.

Da sa to aj cez OLE Drag & Drop, ale pre drag&drop suborov z explorera
(alebo inych aplikacii, ktore pouzivaju CF_HDROP format) mozes pouzit
jednoduchsi sposob cez DragAcceptFiles a spracovanie WM_DROPFILES.
Na to som si napisal jeden velmi jednoduchy komponent, snad Ti pomoze.
Staci mu nastavit vlastnost Control (napriklad listview alebo samotny
formular) a napisat si handler na udalost OnDropFiles.
Ak v tom najdes nejaky bug, daj mi prosim vediet, ja to pouzivam zatial bez
problemov.

unit DropFiles;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TDropFilesEvent = procedure (Sender: TObject; Files: TStrings; X, Y:
Integer) of object;

  TDropFiles = class(TComponent)
  private
    FControl: TWinControl;
    FFiles: TStrings;
    FOldWndProc: TWndMethod;
    FSorted: Boolean;

    FOnDropFiles: TDropFilesEvent;

    procedure SetControl(AControl: TWinControl);
    procedure WndProc(var Message: TMessage);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Control: TWinControl read FControl write SetControl;
    property Sorted: Boolean read FSorted write FSorted default False;

    property OnDropFiles: TDropFilesEvent read FOnDropFiles write
FOnDropFiles;
  end;

procedure Register;

implementation

uses
  ShellApi;

procedure Register;
begin
  RegisterComponents('Additional', [TDropFiles]);
end;

{ TDropFiles private }

procedure TDropFiles.SetControl(AControl: TWinControl);
begin
  if AControl <> FControl then
  begin
    if (csDesigning in ComponentState) then
      FControl := AControl
    else
    begin
      if Assigned(FControl) then
      begin
        DragAcceptFiles(FControl.Handle, False);
        FControl.WindowProc := FOldWndProc;
        FOldWndProc := nil;
      end;
      FControl := AControl;
      if Assigned(FControl) then
      begin
        DragAcceptFiles(FControl.Handle, True);
        FOldWndProc := FControl.WindowProc;
        FControl.WindowProc := WndProc;
      end;
    end;
  end;
end;

procedure TDropFiles.WndProc(var Message: TMessage);
var
  P: TPoint;
  I, Count, SLen: Integer;
  S: string;
begin
  case Message.Msg of
    WM_DESTROY:
      begin
        DragAcceptFiles(FControl.Handle, False);
        FControl.WindowProc := FOldWndProc;
        FOldWndProc(Message);
        FOldWndProc := nil;
        FControl := nil;
      end;
    WM_DROPFILES:
      begin
        FFiles := TStringList.Create;
        try
          TStringList(FFiles).Sorted := FSorted;
          Message.Result := 0;
          if Assigned(FOnDropFiles) then
          begin
            if DragQueryPoint(Message.WParam, P) then
            begin
              Count := DragQueryFile(Message.WParam, UINT(-1), '', 0);
              for I := 0 to Count - 1 do
              begin
                SLen := DragQueryFile(Message.WParam, I, '', 0);
                SetLength(S, SLen + 1);
                DragQueryFile(Message.WParam, I, PChar(S), SLen + 1);
                FFiles.Add(S);
              end;
              DragFinish(Message.WParam);
              FOnDropFiles(Self, FFiles, P.x, P.y);
            end;
          end;
        finally
          FFiles.Free;
          FOldWndProc(Message);
        end;
      end;
    else
      FOldWndProc(Message);
  end;
end;

{ TDropFiles protected }

procedure TDropFiles.Notification(AComponent: TComponent; Operation:
TOperation);
begin
  if (AComponent = FControl) and (Operation = opRemove) then
    SetControl(nil);
  inherited Notification(AComponent, Operation);
end;

{ TDropFiles public }

constructor TDropFiles.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FControl := nil;
  FOldWndProc := nil;
  FSorted := False;
end;

destructor TDropFiles.Destroy;
begin
  SetControl(nil);
  inherited Destroy;
end;

end.

HTH
TOndrej